home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / pBytestring < prev    next >
Text File  |  1998-08-01  |  3KB  |  163 lines
  1. (*
  2. The class Bytestring adds further methods to the class String+, aimed
  3. mainly at managing strings of bytes which are arbitrary data, not
  4. just ascii characters, and may contain non-aligned 16- or 32-bit 
  5. quantities.  (Some of the fields in PEF files are good examples.)
  6.  
  7. These methods allow various numbers of bytes to be fetched from
  8. or stored to the current position of the string, with the current
  9. position being updated.
  10. *)
  11.  
  12.  
  13. :class  BYTESTRING  super{ string }
  14.  
  15. :m 1stW:        \ ( -- n )
  16.     ^1st: self  w@  ;m
  17.  
  18. :m 1stL:        \ ( -- n )
  19.     ^1st: self  @  ;m
  20.  
  21. :m >1st:        \ ( c -- )
  22.     ^1st: self  c!  ;m
  23.  
  24. :m >1stW:        \ ( n -- )
  25.     ^1st: self  w!  ;m
  26.  
  27. :m >1stL:
  28.     ^1st: self  !  ;m
  29.  
  30.  
  31. :m nxtC:        \ ( -- c )
  32.     1st: self  1 skip: self  ;m
  33.  
  34. :m nxtW:        \ ( -- n )
  35.     1stW: self  2 skip: self  ;m
  36.  
  37. :m NXTL:        \ ( -- n )
  38.     1stL: self  4 skip: self  ;m
  39.  
  40. :m NXTN:  { n -- n' }
  41.     get: self  n >=
  42.     IF    0 swap  n bounds DO  8 << i c@ or  LOOP
  43.         n skip: self
  44.     ELSE    drop 0
  45.     THEN  ;m
  46.  
  47.  
  48. :m >NXTC:           \ ( c -- )
  49.     >1st: self  1 skip: self  ;m
  50.  
  51. :m >NXTW:           \ ( n -- )
  52.     >1stW: self  2 skip: self  ;m
  53.  
  54. :m >NXTL:            \ ( n -- )
  55.     >1stL: self  4 skip: self  ;m
  56.  
  57. :m >NXT$:       \ ( addr len -- )
  58.     ovwr: self  ;m
  59.  
  60. :m >NXTN:  { val n  -- }
  61.     val pad !
  62.     4 n - pad +  n  >nxt$: self  ;m
  63.     
  64.  
  65. :m +C:        \ ( c -- )
  66.     +: self   ;m
  67.  
  68. :m +W:        \ ( n -- )
  69.     pad w!  pad 2  add: self  ;m
  70.  
  71. :m +L:        \ ( n -- )
  72.     pad !   pad 4  add: self  ;m
  73.  
  74. :m +N:  { n cnt -- }
  75.     n  32  cnt 2* 4* -  <<  pad !
  76.     pad cnt  add: self  ;m
  77.  
  78. ;class
  79.  
  80.  
  81. :class  BYTESTRING_ARRAY  super{  bytestring  array  }
  82.  
  83.     int    CURRENT
  84.  
  85. :m CURRENT:
  86.     get: current  ;m
  87.  
  88. :m (SEL):  { idx -- }
  89.     idx  put: current
  90.     idx ^elem4 @  ^base !
  91.     nil?: self  ?EXIT
  92.     ^base  size: handle  put: size  ;m
  93.  
  94. :m SELECT:  { idx -- }
  95.     idx (sel): self
  96.     nil?: self
  97.     IF        \ new: not done - do it now
  98.         new: super
  99.         handle: self  idx ^elem4 !
  100.     ELSE
  101.         reset: self
  102.     THEN  ;m
  103.  
  104. :m NEW:  ;m        \ Not needed now, as select: does it if necessary.
  105.  
  106. :m RELEASE:
  107.     limit 0 DO
  108.         i (sel): self  release: super    \ Harmless if not open
  109.         nilH  i ^elem4 !
  110.     LOOP  ;m
  111.  
  112. :m CLEARALL:
  113.     limit 0 DO
  114.         i (sel): self
  115.         handle: self  IF  clear: super  THEN
  116.     LOOP  ;m
  117.  
  118. :m DUMP:
  119.     ." Current:"  get: current  .  cr
  120.     dump: super  ;m
  121.  
  122. :m CLASSINIT:
  123.     idxbase  limit 4*  bounds
  124.     DO  nilH  i !  4 +LOOP  ;m
  125.  
  126. ;class
  127.  
  128.  
  129. endload
  130.  
  131. \ =========== the current test block ============
  132.  
  133. : selectTest
  134.     SELECT[    1    ]=>
  135.           [    2    ]=>
  136.           [    3    ]=>    23
  137.           [ 6    ]=> 200 200 dump
  138.           [ 9    ]=> 99 88 77
  139.     DEFAULT=> 1234
  140.     ]SELECT
  141. ;
  142.  
  143.  
  144. :f TEST { \ x -- }
  145. dbgr
  146.     cr cr ." hi there one and all!" cr  1 2 3
  147.     begin
  148.         query cr
  149.         begin
  150.             rest nip 0>
  151.         while
  152.             defined?
  153.             if        execute
  154.             else
  155.                     number  selectTest
  156.             then
  157.         repeat
  158.         .s cr
  159.     again
  160. ;f
  161.  
  162. :f quit  test  ;f        \ temp so we can catch errors!
  163.